COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003	! ALPRIN
C00016 00004	! pvdo & pvldo
C00020 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC

	ENTRY;

BEGIN  "ALPRIN"

    IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING="FALSE"; ENDC
    IFCR ¬ CREFFING THENC
	REQUIRE "HALREQ.HDR[HAL,HE]" SOURCE_FILE;
    ENDC
    REDEFINE $$PRGID "[]" = ["ALPRIN"];
    IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
ENDC


INITIALIZE(INITIALIZE_OUTPUT);

INTERNAL INTEGER PSPCIX;INITIALIZE(PSPCIX←0);

INTERNAL SIMPLE PROCEDURE PRCRLF;
	PRINT(CRLF,("                      "
		   &"                      ")[1 FOR PSPCIX]);


INTERNAL SIMPLE STRING PROCEDURE CVRAD(REAL W);
	RETURN(CVF(W/180)&"*π");

INTERNAL SIMPLE STRING PROCEDURE CVDEG(REAL W);
	RETURN(CVF(W)&"*DEG");

INTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
	RETURN(TBLKSUPPRESS(CVG(R)));

STRING PROCEDURE LBLID(RPTR(LBLVAR) LBL);
	RETURN(IF LBL=NULL_RECORD THEN "<nameless>" ELSE
		ITMNAM(LBLVAR:NAME[LBL]));
! ALPRIN;

INTERNAL RECURSIVE PROCEDURE ALPRIN(RANY S);
	BEGIN "ALPRIN"
	LABEL REPRINT,XIT,HALPR2;
	INTEGER ST;
	RCELL C;

	RECURSIVE PROCEDURE HPFIN(RCELL C);
		BEGIN
		PSPCIX←PSPCIX+1;
		WHILE C≠NULL_RECORD DO ALPRIN(LLOP(C));
		PRCRLF;
		PSPCIX←PSPCIX-1;
		END;

REPRINT:
	ST←RECTYPE(S);
	
	IF ST=LOC(SVAL) THEN
		PRINT(SVAL:VAL[S])
	ELSE IF ST=LOC(V3ECT) THEN
		BEGIN
		BOOLEAN PROCEDURE VPRINT(RPTR(V3ECT) V,NV;STRING ID);
			BEGIN
			RANY SS; ! because of SAIL dryrot;
			SS←S;
			IF V3DIST(SS,V)=0 THEN PRINT(" "&ID)
			ELSE IF V3DIST(SS,NV)=0 THEN PRINT("-"&ID)
			ELSE RETURN(FALSE);
			RETURN(TRUE);
			END;
		IF ¬VPRINT(NILVECT,NILVECT,"NILVECT") ∧
		   ¬VPRINT(XHAT,NEGXHAT,"XHAT") ∧
		   ¬VPRINT(YHAT,NEGYHAT,"YHAT") ∧
		   ¬VPRINT(ZHAT,NEGZHAT,"ZHAT") THEN
			    PRINT(" VECTOR(", CVGX(V3ECT:X[S]),",",
				 CVGX(V3ECT:Y[S]),",",CVGX(V3ECT:Z[S]),")" );
		END
	ELSE IF ST=LOC(ROTN) THEN
		BEGIN
		IF S=NILROTN THEN
			PRINT(" NILROTN")
		ELSE
			BEGIN
			PRINT(" ROTN( ");
			ALPRIN(ROTN:AXIS[S]);
			PRINT(",",CVDEG(ROTN:MAGN[S]),")");
			END;
		END
	ELSE IF ST=LOC(TRANS) THEN
		BEGIN  !  Modified by RF;
		IF S=NILTRANS THEN
			PRINT(" NILTRANS")
		ELSE
			BEGIN
			PRINT(" TRANS(");
			ALPRIN(TRANS:R[S]);
			PRINT(",");
			ALPRIN(TRANS:P[S]);
			PRINT(")");
			END;
		END
	ELSE IF ST=LOC(FRAME) THEN
		BEGIN  !  Modified by RF;
		IF S=STATION THEN
			PRINT(" STATION")
		ELSE BEGIN
			PRINT(" FRAME(");
			ALPRIN(TRANS:R[FRAME:VAL[S]]);
			PRINT(",");
			ALPRIN(TRANS:P[FRAME:VAL[S]]);
			PRINT(")");
			END;
		END
	ELSE IF ST=LOC(VARIABLE) THEN 
		BEGIN
		PRINT(" ",VARIABLE:NAME[S]);
		END
	ELSE IF ST=LOC(STCONST) THEN 
		BEGIN
		PRINT(" ",DATUM(STCONST:VAL[S]));
		END
	ELSE IF ST=LOC(EXPRN) THEN
		BEGIN
		PRINT("(",OP_MNE[EXPRN:OP[S]]);
		C←EXPRN:ARGS[S];
		WHILE C≠NULL_RECORD DO ALPRIN(LLOP(C));
		PRINT(")");
		END
	ELSE IF ST=LOC(VNODE) THEN
		BEGIN
		PRINT("[INV=",VNODE:INVMARK[S],",VAL=");
		ALPRIN(VNODE:NOMVAL[S]);
		PRINT("]");
		END
	ELSE IF ST=LOC(CALCULATOR) THEN
		BEGIN
		PRINT("( calc ",LBLID(CALCULATOR:LBL[S]),": ");
		ALPRIN(CALCULATOR:FORM[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(CHANGER) THEN
		BEGIN
		PRINT("(changer ",LBLID(CHANGER:LBL[S]),": ");
		ALPRIN(CHANGER:CODE[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(STMNT) THEN
		BEGIN
		ALPRIN(STMNT:SEMANTICS[S]);
		PRINT(" [IW=",STMNT:IW[S],",OW=",STMNT:OW[S],"]");
		END
	ELSE IF ST=LOC(AFACT) THEN
		BEGIN
		PRINT("(");
		ALPRIN(AFACT:LEFT[S]);
		PRINT(" ","<≤=≥>"[AFACT:RELN[S]+3 FOR 1]);
		ALPRIN(AFACT:RIGHT[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(SFACT) THEN
		BEGIN
		PRINT(" FACT ");
		S←SFACT:PATT[S];
		GO TO REPRINT;
		END
	ELSE IF ST=LOC(CELL) THEN
		BEGIN
		PRINT("(");
		WHILE S≠NULL_RECORD DO
			BEGIN
			ALPRIN(CELL:CAR[S]);
			S←CELL:CDR[S];
			END;
		PRINT(" )");
		END
	ELSE IF ST=0 THEN
		PRINT(" NULL_RECORD ")
        ELSE IF ST=LOC(CMON) THEN
                BEGIN
		!  Recoded by RF;
		PRINT(" (ON ");
		ALPRIN(CMON:CONDITION[S]);
		PRINT(" DO ");
		ALPRIN(CMON:CONCLUSION[S]);
		PRINT(" )");
                END
        ELSE IF ST = LOC(EVDO) THEN
                BEGIN  ! Added by RF;
                IF EVDO:OP[S] = 0
                THEN PRINT("(SIGNAL ")
                ELSE PRINT("(WAIT ");
                ALPRIN(EVDO:VAR[S]);
                PRINT(")");
                END
	ELSE
		BEGIN
		GO TO HALPR2;
		! this admittedly ugly goto statement is here
		  because otherwise you have to use a bigger 
		  parse stack in compiling this program, which
		  is a real pain. ;
		END;
	GO TO XIT; ! see the remark immediately above;
	HALPR2: BEGIN
		PRCRLF;
		PRINT("(",CVRTS(ST));
		IF ST=LOC(BLOCK)∨ST=LOC(COBLOCK) THEN
			BEGIN
			IF ST=LOC(BLOCK)
			    THEN BEGIN  ! Modified by RF;
			    C ← BLOCK:VARS[S];
			    HPFIN(C);
			    C ← BLOCK:CODE[S];
			    END
			ELSE IF ST=LOC(COBLOCK) THEN
				C←COBLOCK:CODE[S];
			HPFIN(C);
			END
		ELSE IF ST=LOC(PROG) THEN
			BEGIN
			ALPRIN(PROG:CODE[S]);
			END
		ELSE IF ST=LOC(ASSIGNMENT) THEN
			BEGIN
			ALPRIN(ASSIGNMENT:VAR[S]);
			PRINT(" ");
			ALPRIN(ASSIGNMENT:VAL[S]);
			END
		ELSE IF ST=LOC(GASSIGN) THEN
			BEGIN
			ALPRIN(GASSIGN:VAR[S]);
			PRINT("=≠<"[GASSIGN:OP[S] FOR 1]);
			ALPRIN(GASSIGN:CLC[S]);
			END
		ELSE IF ST=LOC(ASSERT)∨ST=LOC(DENY) THEN
			BEGIN
			ALPRIN(ASSERT:FACT[S]);
			PRINT(" IN ",ASSERT:WLD[S]);
			END
		ELSE IF ST=LOC(MOVE$) THEN
			BEGIN
			ALPRIN(MOVE$:WHAT[S]);
			PRINT(" TO ");
			ALPRIN(MOVE$:DEST[S]);
			IF MOVE$:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				PRCRLF;
				HPFIN(MOVE$:CLAUSES[S]);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(CENTER) THEN
			BEGIN
			ALPRIN(CENTER:CF[S]);
			IF CENTER:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				PRCRLF;
				HPFIN(CENTER:CLAUSES[S]);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(PVL) THEN
			ALPRIN(PVL:VL[S])
		ELSE IF ST=LOC(IFF) THEN
			BEGIN
			ALPRIN(IFF:COND[S]);
			PSPCIX←PSPCIX+1;
			ALPRIN(IFF:THN[S]);
			ALPRIN(IFF:ELS[S]);
			PRCRLF;
			PSPCIX←PSPCIX-1;
			END
		ELSE IF ST = LOC(WHIL) THEN
			BEGIN
			ALPRIN(WHIL:COND[S]);
			PSPCIX←PSPCIX+1;
			PRCRLF;
			ALPRIN(WHIL:BODY[S]);
			PSPCIX←PSPCIX-1;
			END
                ELSE IF ST = LOC(VIA) THEN
                        BEGIN "via"
                        ALPRIN(VIA:PLACE[S]);
                        IF VIA:VELOC[S] ≠ RNULL THEN ALPRIN(VIA:VELOC[S]);
                        IF VIA:TIME[S] ≠ RNULL THEN ALPRIN(VIA:TIME[S]);
                        IF VIA:CODE[S] ≠ RNULL THEN ALPRIN(VIA:CODE[S]);
                        END "via"
                ELSE IF ST = LOC(DURATION) THEN
                        BEGIN "duration"
                        PRINT(CASE DURATION:TIME_RELN[S] OF
			    (" ? "," > "," < "," = "));
                        ALPRIN(DURATION:TIME[S]);
                        END "duration"
                ELSE IF ST = LOC(PRNT) THEN
			ALPRIN(PRNT:VAL[S])
                ELSE IF ST = LOC(STOP) THEN
			ALPRIN(STOP:CF[S])
		ELSE
			BEGIN
			RECPRN(S);
			END;
		PRINT(")");
		END;
XIT:	RETURN
	END "ALPRIN";

PROCEDURE INIPFS;
	BEGIN
	INTEGER HPL;
	HPL←LOC(ALPRIN);
	SETRPM(LOC(FRAME),HPL);
	SETRPM(LOC(TRANS),HPL);
	SETRPM(LOC(ROTN),HPL);
	SETRPM(LOC(STMNT),HPL);
	SETRPM(LOC(BLOCK),HPL);
	SETRPM(LOC(VARIABLE),HPL);
	SETRPM(LOC(CHANGER),HPL);
	SETRPM(LOC(CALCULATOR),HPL);
	SETRPM(LOC(EXPRN),HPL);
	END;

REQUIRE INIPFS INITIALIZATION;
! pvdo & pvldo;

PROCEDURE ATLPRT(ITEMVAR W;STRING ATTID;RPTR(SET_FLUENT) ATTFL);
        BEGIN
        INTEGER FLG;
        RANY VV;
	PRCRLF;
        PRINT(TAB,ATTID,"=");
        PSPCIX←PSPCIX+10;
        FLG←0;
        ∀ | SATISFY_SET_FLUENT(W,ATTFL,VV) DO
                BEGIN
		IF FLG THEN
	                PRCRLF;
                ALPRIN(VV);
                FLG←1;
                END;
        IF ¬FLG THEN PRINT(" <NONE> ");
        PSPCIX←PSPCIX-10;
        END;

INTERNAL PROCEDURE PCDO(RPTR(CALCULATOR) V;ITEMVAR WLD);
	BEGIN

	! prints out a "pretty" version of the graph node
	for calculator V in world WLD.;

	RPTR(VNODE) GN;
	GN←GETFREC(CALCULATOR:PLNVAL[V],WLD);
	PRCRLF;
	PRINT("IN WORLD ",WLD,", CALCULATOR ",LBLID(CALCULATOR:LBL[V]),
			" HAS GRAPH PROPERTIES:");
	PSPCIX←PSPCIX+10;
	PRCRLF;
	PRINT("VALUE NODE =");
	ALPRIN(GN);
	PSPCIX←PSPCIX-10;
	PRCRLF;
	ATLPRT(WLD,"DEPS",CALCULATOR:DEPS[V]);
	PRCRLF;
	END;

INTERNAL PROCEDURE PVDO(RPTR(VARIABLE) V;ITEMVAR WLD);
	BEGIN

	! prints out a "pretty" version of the graph node
	for variable VAR in world WLD.;

	RPTR(VNODE) GN;
	RPTR(CALCULATOR) C;
	BOOLEAN FLG;

	GN←GETFREC(VARIABLE:PLNVAL[V],WLD);
	PRCRLF;
	PRINT("IN WORLD ",ITMNAM(WLD),", ",VARIABLE:NAME[V],
		" HAS GRAPH PROPERTIES:");
	PSPCIX←PSPCIX+10;
	PRCRLF;
	PRINT("VALUE NODE =");
	ALPRIN(GN);
	PSPCIX←PSPCIX-10;
	ATLPRT(WLD,"DEPS",VARIABLE:DEPS[V]);
	ATLPRT(WLD,"CALCS",VARIABLE:CALCS[V]);
	ATLPRT(WLD,"CHANGERS",VARIABLE:CHANGERS[V]);
	PRCRLF;
	PSPCIX←PSPCIX+10;
	∀ | SATISFY_SET_FLUENT(WLD,VARIABLE:CALCS[V],C) DO
		BEGIN
		PCDO(C,WLD);
		FLG←TRUE;
		END;
	PSPCIX←PSPCIX-10;
	PRCRLF;
	END;

INTERNAL PROCEDURE PVLDO(RCELL C;ITEMVAR WLD);
	BEGIN
	WHILE C≠NULL_RECORD DO 
		BEGIN
		PVDO(CHKREC(CELL:CAR[C],LOC(VARIABLE)),WLD);
		C←CELL:CDR[C];
		END;
	END;

END $$PRGID;